home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / bdeorx / BDEDORX.ZIP / RestUser / UserRes1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-08  |  22.9 KB  |  750 lines

  1. unit UserRes1;
  2. {
  3. *********************************************************
  4. *  demo for use of def files with local tables at your  *
  5. *  client's site                                        *
  6. *                                                       *
  7. *  (c) 1996-97 Reinhard Kalinke                         *
  8. *                                                       *
  9. *********************************************************
  10. }
  11.  
  12. {NOTE When compiling the samples or a project of your own using 
  13. BDEDoRxS methods with Delphi 1 tests seem to indicate that you 
  14. better increase stack size to 24 or even 32k.}
  15.  
  16. interface
  17.  
  18. uses
  19.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
  20.   Forms, Dialogs, StdCtrls, FileCtrl, Db, DBTables, Px7Table,
  21.   IniFiles, ExtCtrls,
  22.   {$IFDEF WIN32}
  23.   ComCtrls,
  24.   {$ELSE}
  25.   Gauges,
  26.   {$ENDIF}
  27.   DBIProcs;
  28.  
  29. type
  30.   TMainForm = class(TForm)
  31.     GroupBox1: TGroupBox;
  32.     AliasCB: TComboBox;
  33.     GroupBox2: TGroupBox;
  34.     DriveBox1: TDriveComboBox;
  35.     DirBox1: TDirectoryListBox;
  36.     GroupBox3: TGroupBox;
  37.     TblCreateCB: TCheckBox;
  38.     IndexCB: TCheckBox;
  39.     DoItBtn: TButton;
  40.     RestTbl: TPx7Table;
  41.     RestDB: TDatabase;
  42.     DeleteCB: TCheckBox;
  43.     ValcheckCB: TCheckBox;
  44.     RefIntCB: TCheckBox;
  45.     Panel1: TPanel;
  46.     Panel2: TPanel;
  47.     IdxCB: TCheckBox;
  48.     Bevel1: TBevel;
  49.     procedure FormShow(Sender: TObject);
  50.     procedure AliasCBChange(Sender: TObject);
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure DoItBtnClick(Sender: TObject);
  53.     procedure ValcheckCBClick(Sender: TObject);
  54.     procedure IdxCBClick(Sender: TObject);
  55.   private
  56.     { Private-Deklarationen }
  57.     FCalced: boolean;
  58.     FBDEVersion: string;
  59.     FDeleteVals: boolean;
  60.     FPreventSizing: boolean;
  61.     {$IFDEF WIN32}
  62.     ProgressBar1: TProgressBar;
  63.     {$ELSE}
  64.     ProgressBar1: TGauge;
  65.     {$ENDIF}
  66.     procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  67.               message WM_GETMINMAXINFO;
  68.     procedure WMNCHitTest(var Msg: TWMNCHitTest);
  69.               message WM_NCHitTest;
  70.     procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  71.               message WM_INITMENUPOPUP;
  72.   public
  73.     { Public-Deklarationen }
  74.   end;
  75.  
  76. var
  77.   MainForm: TMainForm;
  78.  
  79. implementation
  80.  
  81. {$R *.DFM}
  82.  
  83. uses BDEDoRxS;
  84.  
  85. procedure AssignDBDir(ADataBase: TDataBase; const AFileName: TFileName);
  86. begin
  87.   with ADataBase do
  88.   if (Params.Count = 0)
  89.   or (Params[0] <> 'PATH='+AFileName) then
  90.   begin
  91.     if Connected then Connected := False;
  92.     DriverName := 'STANDARD'; {clears any alias as well}
  93.     Params.Clear;
  94.     Params.Add('PATH='+AFileName);
  95.     Open;
  96.   end;
  97. end;
  98.  
  99. {'Wrappers' you might want to paste into your apps/restructors.
  100.  For an example on how to use them check form method DoItBtnClick}
  101.  
  102. {scans a dir for files with extension AExt and writes them
  103.  into a list for further processing}
  104. function DoScanDirForFiles(const ADir,AExt: TFileName;
  105.                            AList: TStrings): integer;
  106. var FileRec: TSearchRec;
  107.     ScanDir: TFileName;
  108.     Res: integer;
  109. begin
  110.   AList.Clear;
  111.   if (ADir[Length(ADir)] <> '\') then ScanDir := ADir+'\'
  112.   else ScanDir := ADir;
  113.   Res := SysUtils.FindFirst(ScanDir+'*.'+AExt, 0, FileRec);
  114.   while Res = 0 do
  115.   begin
  116.     AList.Add(ScanDir+FileRec.Name);
  117.     Res := SysUtils.FindNext(FileRec);
  118.   end;
  119.   SysUtils.FindClose(FileRec);
  120.   Result := AList.Count;
  121. end;
  122.  
  123. {writes table defs for a list of tables}
  124. procedure DoWriteTableDefsToFile(AFileList: TStrings;
  125.                                  ATable: TTable;
  126.                                  const AVersion: string;
  127.                                  DoUseFieldIDs: boolean;
  128.                                  {$IFDEF WIN32}
  129.                                  AProgressBar: TProgressBar;
  130.                                  {$ELSE}
  131.                                  AProgressBar: TGauge;{}
  132.                                  {$ENDIF}
  133.                                  AStatusPanel: TPanel);
  134. var i,iProg: integer;
  135.     DBFile, DefFile: TFileName;
  136. begin
  137.   Screen.Cursor := crHourGlass;
  138.   try
  139.     iProg := 0;
  140.     {$IFDEF WIN32}
  141.     AProgressBar.Position := 0;
  142.     AProgressBar.Max := AFileList.Count;
  143.     {$ELSE}
  144.     AProgressBar.Progress := 0;
  145.     AProgressBar.MaxValue := AFileList.Count;
  146.     {$ENDIF}
  147.     for i:=0 to pred(AFileList.Count) do
  148.     begin
  149.       DBFile := AFileList.Strings[i];
  150.       DefFile := ChangeFileExt(DBFile,'.dbi');
  151.       with TIniFile.Create(DefFile) do
  152.       try
  153.         ATable.TableName := ExtractFileName(DBFile);
  154.         ATable.Open;
  155.         AStatusPanel.Caption := 'creating table def: '
  156.                                 +DefFile;
  157.         AStatusPanel.Update;
  158.         BDESaveTableDefsToFile(ATable, DefFile);
  159.         if (AVersion > '') then
  160.           WriteString('Table','Version',AVersion);
  161.         if DoUseFieldIDs then
  162.           WriteString('Table','FieldCompare','ByFieldID')
  163.         else
  164.           WriteString('Table','FieldCompare','ByFieldName');
  165.       finally
  166.         Free;
  167.         ATable.Close;
  168.       end;
  169.       inc(iProg);
  170.       {$IFDEF WIN32}
  171.       AProgressBar.Position := iProg;
  172.       {$ELSE}
  173.       AProgressBar.Progress := iProg;
  174.       {$ENDIF}
  175.     end;
  176.     AStatusPanel.Caption := 'Done!';
  177.     AStatusPanel.Update;
  178.   finally
  179.     Screen.Cursor := crDefault;
  180.   end;
  181. end;
  182.  
  183. {writes index defs only for a list of tables}
  184. procedure DoWriteIndexDefsToFile(AFileList: TStrings;
  185.                                  ATable: TTable;
  186.                                  const AVersion: string;
  187.                                  {$IFDEF WIN32}
  188.                                  AProgressBar: TProgressBar;
  189.                                  {$ELSE}
  190.                                  AProgressBar: TGauge;
  191.                                  {$ENDIF}
  192.                                  AStatusPanel: TPanel);
  193. var i,iProg: integer;
  194.     DBFile, DefFile: TFileName;
  195. begin
  196.   Screen.Cursor := crHourGlass;
  197.   try
  198.     iProg := 0;
  199.     {$IFDEF WIN32}
  200.     AProgressBar.Position := 0;
  201.     AProgressBar.Max := AFileList.Count;
  202.     {$ELSE}
  203.     AProgressBar.Progress := 0;
  204.     AProgressBar.MaxValue := AFileList.Count;
  205.     {$ENDIF}
  206.     for i:=0 to pred(AFileList.Count) do
  207.     begin
  208.       DBFile := AFileList.Strings[i];
  209.       DefFile := ChangeFileExt(DBFile,'.dbx');
  210.       with TIniFile.Create(DefFile) do
  211.       try
  212.         ATable.TableName := ExtractFileName(DBFile);
  213.         ATable.Open;
  214.         AStatusPanel.Caption := 'creating index def: '
  215.                                 +DefFile;
  216.         AStatusPanel.Update;
  217.         BDESaveIndexDefsToFile(ATable, DefFile);
  218.         if (AVersion > '') then
  219.           WriteString('Table','Version',AVersion);
  220.       finally
  221.         Free;
  222.         ATable.Close;
  223.       end;
  224.       inc(iProg);
  225.       {$IFDEF WIN32}
  226.       AProgressBar.Position := iProg;
  227.       {$ELSE}
  228.       AProgressBar.Progress := iProg;
  229.       {$ENDIF}
  230.     end;
  231.     AStatusPanel.Caption := 'Done!';
  232.     AStatusPanel.Update;
  233.   finally
  234.     Screen.Cursor := crDefault;
  235.   end;
  236. end;
  237.  
  238. {processes table defs with thw whole range of current
  239.  options (indices, RI, Val)}
  240. procedure DoRestructureFromFile(AFileList: TStrings;
  241.                                 ADataBase: TDataBase;
  242.                                 ATable: TTable;
  243.                                 {$IFDEF WIN32}
  244.                                 AProgressBar: TProgressBar;
  245.                                 {$ELSE}
  246.                                 AProgressBar: TGauge;
  247.                                 {$ENDIF}
  248.                                 AStatusPanel: TPanel;
  249.                                 const DoCreateTables,
  250.                                 DoCreateIndices,
  251.                                 DoCreateRefInt,
  252.                                 DoCreateValchecks,
  253.                                 DoDeleteDefs: boolean);
  254. var i,iProg,iPass,iPasses: integer;
  255.     DefFile, DBFile: TFileName;
  256.     DoIndex: boolean;
  257.     ActionStr: string;
  258. begin
  259.   Screen.Cursor := crHourGlass;
  260.   try
  261.     DoIndex := DoCreateIndices;
  262.     if (DoCreateRefInt or DoCreateValchecks) then
  263.       iPasses := 2 else iPasses := 1;
  264.     {$IFDEF WIN32}
  265.     AProgressBar.Max := AFileList.Count*(1+ord(DoIndex));
  266.     {$ELSE}
  267.     AProgressBar.MaxValue := AFileList.Count*(1+ord(DoIndex));
  268.     {$ENDIF}
  269.     for iPass:=1 to iPasses do
  270.     begin
  271.       iProg := 0;
  272.       {$IFDEF WIN32}
  273.       AProgressBar.Position := 0;
  274.       {$ELSE}
  275.       AProgressBar.Progress := 0;{}
  276.       {$ENDIF}
  277.       if (iPass = 1) then
  278.         ActionStr := 'processing: '
  279.       else
  280.         ActionStr := 'creating RI and/or ValChecks: ';
  281.       for i:=0 to pred(AFileList.Count) do
  282.       begin
  283.         DefFile := AFileList.Strings[i];
  284.         with TIniFile.Create(DefFile) do
  285.         try
  286.           ATable.TableName := ReadString('Table','Name','');
  287.           AStatusPanel.Caption := ActionStr+ATable.TableName;
  288.           AStatusPanel.Update;
  289.           if (iPass = 2) then
  290.           begin
  291.             ATable.Open;
  292.             {'Bugfix' BDE4.0:}
  293.             if MainForm.FDeleteVals then
  294.               BDEDropValFile(ATable);
  295.             if DoCreateRefInt then
  296.              {dropping existing RI is included
  297.               with below function}
  298.               BDEAddRIFromFile(ATable, DefFile);
  299.             inc(iProg);
  300.             {$IFDEF WIN32}
  301.             AProgressBar.Position := iProg;
  302.             {$ELSE}
  303.             AProgressBar.Progress := iProg;{}
  304.             {$ENDIF}
  305.             if DoCreateValchecks then
  306.              {dropping existing val is included
  307.               with below function}
  308.               BDEAddValchecksFromFile(ATable, DefFile); {}
  309.             inc(iProg);
  310.             {$IFDEF WIN32}
  311.             AProgressBar.Position := iProg;
  312.             {$ELSE}
  313.             AProgressBar.Progress := iProg;{}
  314.             {$ENDIF}
  315.             Continue;
  316.           end
  317.           else
  318.           try
  319.             ATable.Open;
  320.             if DoCreateRefInt then
  321.               BDEDropAllRIConstraints(ATable);
  322.             if DoCreateIndices then
  323.               BDEDropAllIndices(ATable);
  324.             BDERestructTableFromFile(ATable, DefFile);
  325.             inc(iProg);
  326.             {$IFDEF WIN32}
  327.             AProgressBar.Position := iProg;
  328.             {$ELSE}
  329.             AProgressBar.Progress := iProg;{}
  330.             {$ENDIF}
  331.           except
  332.             on E:EDBEngineError do
  333.             begin
  334.               DoIndex := False;
  335.               {if table does not exist:}
  336.               if ((E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_OSENOENT)
  337.               or (E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_NOSUCHTABLE))
  338.               and DoCreateTables then
  339.               begin
  340.                 BDECreateTableFromFile(ADataBase, DefFile);
  341.                 inc(iProg);
  342.                 {$IFDEF WIN32}
  343.                 AProgressBar.Position := iProg;
  344.                 {$ELSE}
  345.                 AProgressBar.Progress := iProg;{}
  346.                 {$ENDIF}
  347.                 DoIndex := DoCreateIndices;
  348.                 ATable.Open;
  349.                 DBISaveChanges(ATable.Handle);
  350.               end
  351.               else raise;
  352.             end;
  353.             else raise;
  354.           end;
  355.           if DoIndex then
  356.             {dropping existing indices is included
  357.              with below function}
  358.             BDEAddIndicesFromFile(ATable, DefFile);
  359.           inc(iProg);
  360.           {$IFDEF WIN32}
  361.           AProgressBar.Position := iProg;
  362.           {$ELSE}
  363.           AProgressBar.Progress := iProg;{}
  364.           {$ENDIF}
  365.         finally
  366.           Free;
  367.           ATable.Close;
  368.         end;
  369.       end;
  370.     end;
  371.     AStatusPanel.Caption := 'Done!';
  372.     AStatusPanel.Update;
  373.   finally
  374.     Screen.Cursor := crDefault;
  375.   end;
  376.   if DoDeleteDefs then
  377.   begin
  378.     for i:=0 to pred(AFileList.Count) do
  379.       SysUtils.DeleteFile(AFileList.Strings[i]);
  380.   end;
  381. end;
  382.  
  383. {processes table defs for field restructure and indices only
  384.  (no RI or Val processing)}
  385. procedure DoSimpleRestructureFromFile(AFileList: TStringList;
  386.                                 ADataBase: TDataBase;
  387.                                 ATable: TTable;
  388.                                 {$IFDEF WIN32}
  389.                                 AProgressBar: TProgressBar;
  390.                                 {$ELSE}
  391.                                 AProgressBar: TGauge;
  392.                                 {$ENDIF}
  393.                                 AStatusPanel: TPanel;
  394.                                 const DoCreateTables,
  395.                                 DoCreateIndices,
  396.                                 DoDeleteDefs: boolean);
  397. var i,iProg: integer;
  398.     DefFile, DBFile: TFileName;
  399.     DoIndex: boolean;
  400.     Res: integer;
  401.     FileRec: TSearchRec;
  402. begin
  403.   Screen.Cursor := crHourGlass;
  404.   try
  405.     DoIndex := DoCreateIndices;
  406.     iProg := 0;
  407.     {$IFDEF WIN32}
  408.     AProgressBar.Position := 0;
  409.     AProgressBar.Max := AFileList.Count*(1+ord(DoIndex));
  410.     {$ELSE}
  411.     AProgressBar.Progress := 0;
  412.     AProgressBar.MaxValue := AFileList.Count*(1+ord(DoIndex));
  413.     {$ENDIF}
  414.     for i:=0 to pred(AFileList.Count) do
  415.     begin
  416.       DefFile := AFileList.Strings[i];
  417.       with TIniFile.Create(DefFile) do
  418.       try
  419.         ATable.TableName := ReadString('Table','Name','');
  420.         AStatusPanel.Caption := 'processing: '+ATable.TableName;
  421.         AStatusPanel.Update;
  422.         try
  423.           ATable.Open;
  424.           if DoCreateIndices then
  425.             BDEDropAllIndices(ATable);
  426.           BDERestructTableFromFile(ATable, DefFile);
  427.           inc(iProg);
  428.           {$IFDEF WIN32}
  429.           AProgressBar.Position := iProg;
  430.           {$ELSE}
  431.           AProgressBar.Progress := iProg;
  432.           {$ENDIF}
  433.         except
  434.           on E:EDBEngineError do
  435.           begin
  436.             DoIndex := False;
  437.             {if table does not exist:}
  438.             if ((E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_OSENOENT)
  439.             or (E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_NOSUCHTABLE))
  440.             and DoCreateTables then
  441.             begin
  442.               BDECreateTableFromFile(ADataBase, DefFile);
  443.               inc(iProg);
  444.               {$IFDEF WIN32}
  445.               AProgressBar.Position := iProg;
  446.               {$ELSE}
  447.               AProgressBar.Progress := iProg;
  448.               {$ENDIF}
  449.               DoIndex := DoCreateIndices;
  450.               ATable.Open;
  451.               DBISaveChanges(ATable.Handle);
  452.             end
  453.             else raise;
  454.           end;
  455.           else raise;
  456.         end;
  457.         if DoIndex then
  458.           BDEAddIndicesFromFile(ATable, DefFile);
  459.         inc(iProg);
  460.         {$IFDEF WIN32}
  461.         AProgressBar.Position := iProg;
  462.         {$ELSE}
  463.         AProgressBar.Progress := iProg;
  464.         {$ENDIF}
  465.         finally
  466.         Free;
  467.         ATable.Close;
  468.       end;
  469.     end;
  470.     AStatusPanel.Caption := 'Done!';
  471.     AStatusPanel.Update;
  472.   finally
  473.     Screen.Cursor := crDefault;
  474.   end;
  475.   if DoDeleteDefs then
  476.   begin
  477.     for i:=0 to pred(AFileList.Count) do
  478.       SysUtils.DeleteFile(AFileList.Strings[i]);
  479.   end;
  480. end;
  481.  
  482. {processes defs for indices only}
  483. procedure DoProcessIndicesFromFile(AFileList: TStringList;
  484.                                    ATable: TTable;
  485.                                    {$IFDEF WIN32}
  486.                                    AProgressBar: TProgressBar;
  487.                                    {$ELSE}
  488.                                    AProgressBar: TGauge;
  489.                                    {$ENDIF}
  490.                                    AStatusPanel: TPanel;
  491.                                    const DoDeleteDefs: boolean);
  492. var i,iProg,iPass,iPasses: integer;
  493.     DefFile, DBFile: TFileName;
  494.     Res: integer;
  495.     FileRec: TSearchRec;
  496. begin
  497.   Screen.Cursor := crHourGlass;
  498.   try
  499.     iProg := 0;
  500.     {$IFDEF WIN32}
  501.     AProgressBar.Position := 0;
  502.     AProgressBar.Max := AFileList.Count;
  503.     {$ELSE}
  504.     AProgressBar.Progress := 0;
  505.     AProgressBar.MaxValue := AFileList.Count;
  506.     {$ENDIF}
  507.     for i:=0 to pred(AFileList.Count) do
  508.     begin
  509.       DefFile := AFileList.Strings[i];
  510.       with TIniFile.Create(DefFile) do
  511.       try
  512.         ATable.TableName := ReadString('Table','Name','');
  513.         AStatusPanel.Caption := 'creating indices: '+ATable.TableName;
  514.         AStatusPanel.Update;
  515.         ATable.Open;
  516.         {dropping indices is included with below function}
  517.         BDEAddIndicesFromFile(ATable, DefFile);
  518.         inc(iProg);
  519.         {$IFDEF WIN32}
  520.         AProgressBar.Position := iProg;
  521.         {$ELSE}
  522.         AProgressBar.Progress := iProg;
  523.         {$ENDIF}
  524.       finally
  525.         Free;
  526.         ATable.Close;
  527.       end;
  528.     end;
  529.     AStatusPanel.Caption := 'Done!';
  530.     AStatusPanel.Update;
  531.   finally
  532.     Screen.Cursor := crDefault;
  533.   end;
  534.   if DoDeleteDefs then
  535.   begin
  536.     for i:=0 to pred(AFileList.Count) do
  537.       SysUtils.DeleteFile(AFileList.Strings[i]);
  538.   end;
  539. end;
  540.  
  541. {processes index defs for a list of files in case of
  542.  index errors ('Index out of date')}
  543. procedure DoRecoverIndicesFromFile(AFileList: TStringList;
  544.                                    ADB: TDataBase;
  545.                                    ATable: TTable;
  546.                                    {$IFDEF WIN32}
  547.                                    AProgressBar: TProgressBar;
  548.                                    {$ELSE}
  549.                                    AProgressBar: TGauge;
  550.                                    {$ENDIF}
  551.                                    AStatusPanel: TPanel;
  552.                                    const DoDeleteDefs: boolean);
  553. var i,iProg,iPass,iPasses: integer;
  554.     DefFile, DBFile: TFileName;
  555.     Res: integer;
  556.     FileRec: TSearchRec;
  557. begin
  558.   Screen.Cursor := crHourGlass;
  559.   try
  560.     iProg := 0;
  561.     {$IFDEF WIN32}
  562.     AProgressBar.Position := 0;
  563.     AProgressBar.Max := AFileList.Count;
  564.     {$ELSE}
  565.     AProgressBar.Progress := 0;
  566.     AProgressBar.MaxValue := AFileList.Count;
  567.     {$ENDIF}
  568.     for i:=0 to pred(AFileList.Count) do
  569.     begin
  570.       DefFile := AFileList.Strings[i];
  571.       with TIniFile.Create(DefFile) do
  572.       try
  573.         ATable.TableName := ReadString('Table','Name','');
  574.         AStatusPanel.Caption := 'recovering indices: '+ATable.TableName;
  575.         AStatusPanel.Update;
  576.         BDERecoverIndicesFromFile(ADB, ATable.TableName, DefFile);
  577.         inc(iProg);
  578.         {$IFDEF WIN32}
  579.         AProgressBar.Position := iProg;
  580.         {$ELSE}
  581.         AProgressBar.Progress := iProg;
  582.         {$ENDIF}
  583.       finally
  584.         Free;
  585.       end;
  586.     end;
  587.     AStatusPanel.Caption := 'Done!';
  588.     AStatusPanel.Update;
  589.   finally
  590.     Screen.Cursor := crDefault;
  591.   end;
  592.   if DoDeleteDefs then
  593.   begin
  594.     for i:=0 to pred(AFileList.Count) do
  595.       SysUtils.DeleteFile(AFileList.Strings[i]);
  596.   end;
  597. end;
  598. {end of 'wrapper' section}
  599.  
  600. procedure TMainForm.DoItBtnClick(Sender: TObject);
  601. var AFileList: TStringList;
  602.     i: integer;
  603. begin
  604.   if (AliasCB.Text <> 'use Directories') then
  605.   begin
  606.     RestDB.Close;
  607.     RestDB.Params.Clear;
  608.     RestDB.AliasName := AliasCB.Text;
  609.     RestDB.Open;
  610.   end
  611.   else
  612.     AssignDBDir(RestDB,DirBox1.Directory);
  613.   AFileList := TStringList.Create;
  614.   try
  615.     if IdxCB.Checked then
  616.     begin
  617.       if (DoScanDirForFiles(DirBox1.Directory,'DBX',AFileList) > 0) then
  618.         DoRecoverIndicesFromFile(AFileList,RestDB,RestTbl,
  619.                                  ProgressBar1,Panel1,
  620.                                  DeleteCB.Checked)
  621.       else
  622.         ShowMessage('No files to process');
  623.     end
  624.     else
  625.     begin
  626.       if (DoScanDirForFiles(DirBox1.Directory,'DBI',AFileList) > 0) then
  627.         DoRestructureFromFile(AFileList,RestDB,RestTbl,ProgressBar1,Panel1,
  628.                               TblCreateCB.Checked,IndexCB.Checked,
  629.                               RefIntCB.Checked,ValcheckCB.Checked,
  630.                               DeleteCB.Checked)
  631.       else
  632.         ShowMessage('No files to process');
  633.     end;
  634.   finally
  635.     AFileList.Free;
  636.   end;
  637. end;
  638.  
  639. procedure TMainForm.FormShow(Sender: TObject);
  640. begin
  641.   if not FCalced then
  642.   begin
  643.     CalcControlSize(self);
  644.     {$IFDEF WIN32}
  645.     FBDEVersion := BDEGetIdapi32Version;
  646.     {$ELSE}
  647.     FBDEVersion := BDEGetIdapi16Version;
  648.     {$ENDIF}
  649.     FCalced := True;
  650.     FPreventSizing := True;
  651.   end;
  652. end;
  653.  
  654. procedure TMainForm.AliasCBChange(Sender: TObject);
  655. begin
  656.   if (AliasCB.Text <> 'use Directories') then
  657.     DirBox1.Directory := BDEGetDBPath(AliasCB.Text);
  658.   DirBox1.Enabled := (AliasCB.Text = 'use Directories');
  659.   DriveBox1.Enabled := (AliasCB.Text = 'use Directories');
  660. end;
  661.  
  662. procedure TMainForm.FormCreate(Sender: TObject);
  663. begin
  664.   {$IFDEF WIN32}
  665.   ProgressBar1 := TProgressBar.Create(self);
  666.   {$ELSE}
  667.   ProgressBar1 := TGauge.Create(self);
  668.   {$ENDIF}
  669.   with ProgressBar1 do
  670.   begin
  671.     Parent := Panel2;
  672.     Align := alClient;
  673.     Visible := True;
  674.   end;
  675.   Session.GetAliasNames(AliasCB.Items);
  676.   AliasCB.Items.Insert(0,'use Directories');
  677.   AliasCB.ItemIndex := 0;
  678. end;
  679.  
  680. procedure TMainForm.ValcheckCBClick(Sender: TObject);
  681. begin
  682.   if ValcheckCB.Checked and (FBDEVersion = '4.00') then
  683.     case MessageDlg('You are using version '+FBDEVersion+' of BDE.'+#13#10
  684.                +'Due to a serious bug in this version there is no way'+#13#10
  685.                +'valcheck deletes correctly'+#13#10
  686.                +#13#10
  687.                +'Possible remedies:'+#13#10
  688.                +#13#10
  689.                +'Choose "Yes" to delete all *.VAL files before (re-)creation.'+#13#10
  690.                +'Note that this will also delete all RI checks for the tables'+#13#10
  691.                +'Don''t forget to recreate them as well.'+#13#10
  692.                +#13#10
  693.                +'Choose "No" for an internal error handling that will not'+#13#10
  694.                +'delete the checks but only "null" them.',
  695.                mtConfirmation,mbYesNoCancel,0) of
  696.      mrYes: FDeleteVals := True;
  697.      mrNo:  FDeleteVals := False;
  698.      mrCancel: ValcheckCB.Checked := False;
  699.    end;
  700. end;
  701.  
  702. procedure TMainForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  703. begin
  704.   inherited;
  705.   if FPreventSizing then
  706.     with (self), Msg.MinMaxInfo^ do
  707.     begin
  708.       ptMinTrackSize.x:= Width;
  709.       ptMaxTrackSize.x:= Width;
  710.       ptMinTrackSize.y:= Height;
  711.       ptMaxTrackSize.y:= Height;
  712.     end;
  713. end;
  714.  
  715. procedure TMainForm.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  716. begin
  717.   inherited;
  718.   if FPreventSizing and Msg.SystemMenu then
  719.   begin
  720.     EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED);
  721.     EnableMenuItem(Msg.MenuPopup, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
  722.   end;
  723. end;
  724.  
  725. procedure TMainForm.WMNCHitTest(var Msg: TWMNCHitTest);
  726. begin
  727.   inherited;
  728.   if FPreventSizing then
  729.     with Msg do
  730.       if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
  731.                     HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then
  732.          Result := longint(HTNOWHERE);
  733. end;
  734.  
  735. procedure TMainForm.IdxCBClick(Sender: TObject);
  736. begin
  737.   IndexCB.Enabled := (not IdxCB.Checked);
  738.   RefIntCB.Enabled := (not IdxCB.Checked);
  739.   ValcheckCB.Enabled := (not IdxCB.Checked);
  740.   TblCreateCB.Enabled := (not IdxCB.Checked);
  741.   {$IFDEF WIN32}
  742.   ProgressBar1.Position := 0;
  743.   {$ELSE}
  744.   ProgressBar1.Progress := 0;
  745.   {$ENDIF}
  746.   Panel1.Caption := ' Idle...';
  747. end;
  748.  
  749. end.
  750.